home *** CD-ROM | disk | FTP | other *** search
/ Internet Info 1994 March / Internet Info CD-ROM (Walnut Creek) (March 1994).iso / networking / mail / mh / contrib / audit / audit.pl < prev    next >
Text File  |  1992-11-19  |  7KB  |  332 lines
  1. #
  2. #
  3. # $Revision: 1.13 $
  4. # $Date: 92/05/12 14:34:18 $
  5. #
  6. #
  7.  
  8. # =====
  9. # Subroutine initialize
  10. #    Set up the environment for the user and parse the incoming
  11. #    mail message. 
  12. #
  13. sub initialize {
  14.     local($passwd, $uid, $gid, $quota, $comment, $gcos);
  15.  
  16.     ($user, $passwd, $uid, $gid, $quota, $comment, $gcos, $home, $shell) = 
  17.     getpwnam($ARGV[0]); shift @ARGV;
  18.  
  19.     $ENV{'USER'} = $user;
  20.     $ENV{'HOME'} = $home;
  21.     $ENV{'SHELL'} = $shell;
  22.     $ENV{'TERM'} = "vt100";
  23.  
  24.     &parse_message(STDIN);
  25. }
  26.  
  27.  
  28. # =====
  29. # Subroutine parse_message
  30. #    Parse a message into headers, body and special variables
  31. #
  32. sub parse_message {
  33.     local(*INFILE) = @_;
  34.  
  35.     $/ = '';        # read input in paragraph mode
  36.     %headers = ( );
  37.     @received = ( );
  38.     undef($body);
  39.  
  40.     $header = <INFILE>;
  41.  
  42.     $* = 1;
  43.     while (<INFILE>) { 
  44.     s/^From />From /g;
  45.     $body = "" if !defined($body);
  46.     $body .= $_; 
  47.     };
  48.     $/ = "\n";        
  49.     $* = 0;
  50.  
  51.  
  52.     ;# -----
  53.     ;# $sender comes from the UNIX-style From line (From strike...)
  54.     ;#
  55.     ($sender) = ($header =~ /^From\s+(\S+)/); 
  56.  
  57.  
  58.     ;# -----
  59.     ;# fill out the headers associative array with fields from the mail
  60.     ;# header.
  61.     ;#
  62.     $_ = $header;
  63.     s/\n\s+//g;
  64.     @lines = split('\n');
  65.     for ( @lines ) {
  66.     /^([\w-]*):\s*(.*)/ && do {
  67.         $mheader = $1;
  68.         $mheader =~ tr/A-Z/a-z/;
  69.         if (($mheader eq "cc" || $mheader eq "to") && $headers{$mheader}) {
  70.         $headers{$mheader} .= ", $2";
  71.         } elsif ($mheader eq "received") {
  72.         push(@received, $2);
  73.         } else {
  74.         $headers{$mheader} = $2;
  75.         };
  76.     };
  77.     }
  78.     @received = reverse(@received);
  79.  
  80.  
  81.     ;# -----
  82.     ;# for convenience, $subject is $headers{'subject'} and $precedence is
  83.     ;# $headers{'precedence'}
  84.     ;#
  85.     $subject = $headers{'subject'};
  86.     $subject = "(No subject)" unless $subject;
  87.     $subject =~ s/\s+$//;
  88.     $precedence = $headers{'precedence'};
  89.  
  90.  
  91.     ;# -----
  92.     ;# create arrays for who was on the To, Cc lines
  93.     ;#
  94.     @cc = &expand($headers{'cc'});
  95.     @to = &expand($headers{'to'}); 
  96.     defined($headers{"apparently-to"}) && do {
  97.     $apparentlyto = $headers{"apparently-to"};
  98.     push(@to, &expand($apparentlyto));
  99.     };
  100.  
  101.     ;# -----
  102.     ;# $from comes from From: line. $address is their email address.
  103.     ;# $organization is their site. for example, strike@pixel.convex.com 
  104.     ;# yields an organization of convex.
  105.     ;#
  106.     $_ = $headers{'from'} ||
  107.          $headers{'resent-from'} ||
  108.          $headers{'sender'} ||
  109.          $headers{'resent-sender'} ||
  110.          $headers{'return-path'} ||
  111.          $headers{'reply-to'};
  112.  
  113.     if ($_ eq "") {
  114.        $friendly = $from = $address = $organization = "unknown";
  115.        return;
  116.     };
  117.  
  118.     ($friendly, $address, $from, $organization) = &parse_email_address($_);
  119. }
  120.  
  121.  
  122. # =====
  123. # Subroutine parse_email_address
  124. #    Parse an email address into address, from, organization
  125. #    address is full Internet address, from is just the login
  126. #    name and organization is Internet hostname (without final domain)
  127. #
  128. sub parse_email_address {
  129.     local($_) = @_;
  130.     local($friendly, $address, $from, $organization);
  131.  
  132.     $organization = "local";
  133.     $friendly = "unknown";
  134.  
  135. # From: Disk Monitor Daemon (/usr/adm/bin/dfbitch) <daemon@hydra.convex.com>?
  136.  
  137.     s/^\s*//;
  138.     s/\s*$//;
  139.     if (/(.*)\s*<[^>]+>$|<[^>]+>\s*(.*)$/) {
  140.     $friendly = $+;
  141.     $friendly =~ s/\"//g;
  142.     } elsif (/\(([^\)]+)\)/) {
  143.     $friendly = $1;
  144.     };
  145.  
  146.     s/.*<([^>]+)>.*/$1/;
  147.     s/\(.*\)//;
  148.     s/\s*$//;
  149.     $address = $_;
  150.  
  151.     s/@.*//;
  152.     s/%.*//;
  153.     s/.*!//;
  154.     s/\s//g;
  155.     $from = $_;
  156.  
  157.     $_ = $address;
  158.     tr/A-Z/a-z/;
  159.     if (/!/ && /@/) {
  160.         s/\s//g;
  161.         s/!.*//;
  162.         $organization = $_;
  163.     } elsif (/!/) {
  164.         s/\s//g;
  165.         s/![A-Za-z0-9_@]*$//;
  166.         s/.*!//;
  167.         s/\..*//;
  168.         $organization = $_;
  169.     } elsif (/@/) {
  170.         s/.*@//;
  171.         s/\s//g;
  172.         if (! /\./) {
  173.             $organization = "unknown";
  174.         } else {
  175.             if (/\.(com|edu)$/) {
  176.                 s/\.[A-Za-z0-9_]*$//;
  177.                 s/.*\.//;
  178.             } else {
  179.                 s/\.[A-Za-z0-9_]*$//;
  180.                 s/\.[A-Za-z0-9_]*$//;
  181.                 s/.*\.//;
  182.             };
  183.             $organization = $_;
  184.         };
  185.     };
  186.  
  187.     return ($friendly, $address, $from, $organization);
  188. };
  189.  
  190.  
  191. # ====
  192. # Subroutine vacation
  193. #    deliver a vacation message to the sender of this mail
  194. #    message.
  195. #
  196. sub vacation {
  197.     local($vacfile) = $ENV{'HOME'} . "/" . ".vacation.msg";
  198.     local($msubject) = "\"Vacation mail for $ENV{'USER'} [Re: $subject]\" ";
  199.     local($vacaudit, $astat, $mstat);
  200.     local(@ignores);
  201.     local(@names);
  202.  
  203.     return if (length($from) <= 0);
  204.     return if ($precedence =~ /(bulk|junk)/i);
  205.     return if ($from =~ /-REQUEST@/i);
  206.  
  207.     @ignores = ('daemon', 'postmaster', 'mailer-daemon', 'mailer', 'root',);
  208.     grep(do {return if ($_ eq $from);}, @ignores);
  209.  
  210.     if (-e $vacfile) {
  211.     ($vacaudit = $vacfile) =~ s/\.msg/\.log/;
  212.  
  213.     $mstat = (stat($vacfile))[9];
  214.     $astat = (stat($vacaudit))[9];
  215.     unlink($vacaudit) if ($mstat > $astat);
  216.  
  217.         if (-f $vacaudit) {
  218.         open(VACAUDIT, "< $vacaudit") && do {
  219.         while (<VACAUDIT>) {
  220.             chop; 
  221.             return if ($_ eq $from);
  222.         };
  223.         close(VACAUDIT);
  224.         };
  225.         };
  226.  
  227.         open(MAIL,"| /usr/ucb/Mail -s $msubject $address") || return;
  228.         open(VACFILE, "< $vacfile") || return;    
  229.         while (<VACFILE>) {
  230.         s/\$SUBJECT/$subject/g;
  231.             print MAIL $_;
  232.         };
  233.         close(VACFILE);
  234.         close(MAIL);
  235.  
  236.         open(VACAUDIT, ">> $vacaudit") || return;
  237.         print VACAUDIT "$from\n";
  238.         close(VACAUDIT);
  239.     };
  240. }
  241.  
  242.  
  243. # =====
  244. # Subroutine expand
  245. #     expand a line (To, Cc, etc.) into a list of addressees.
  246. #
  247. sub expand {
  248.     local($_) = @_;
  249.     local(@fccs) = ( );
  250.  
  251.     return(@fccs) if /^$/;
  252.  
  253.     for (split(/\s*,\s*/)) {
  254.     s/.*<([^>]+)>.*/$1/;
  255.     s/@.*//;
  256.     s/.*!//;
  257.     s/\(.*\)//;
  258.     s/\s//g;
  259.     push(@fccs,$_) unless $seen{$_}++;
  260.     } 
  261.  
  262.     return(@fccs);
  263. } 
  264.  
  265.  
  266. # =====
  267. # Subroutine deliver
  268. #    Deliver the incoming mail message to the user's mail drop
  269. #
  270. sub deliver {
  271.  
  272.     &deposit("/usr/spool/mail/$user");
  273. }
  274.  
  275.  
  276. # =====
  277. #    Put the incoming mail into the specified mail drop (file)
  278. #
  279. sub deposit {
  280.     local($drop) = @_;
  281.     local($LOCK_EX) = 2;
  282.     local($LOCK_UN) = 8;
  283.  
  284.     open(MAIL, ">> $drop") || die "open: $!\n";
  285.     flock(MAIL, $LOCK_EX);
  286.     seek(MAIL, 0, 2);
  287.  
  288.     print MAIL "$header";
  289.     print MAIL "$body\n\n" if defined($body);
  290.  
  291.     flock(MAIL, $LOCK_UN);
  292.     close(MAIL);
  293. }
  294.  
  295.  
  296. # =====
  297. # Subroutine file_from
  298. #    Add the mail message to another mail drop in a log directory.
  299. #    The path of the mail drop is toplevel/organization/user
  300. #
  301. sub file_from {
  302.     local($toplevel) = @_;
  303.     local($dir);
  304.  
  305.     return if (length($from) <= 0);
  306.     return if ($from eq $user);
  307.  
  308.     $toplevel = "log" if ($toplevel eq '');
  309.  
  310.     $dir = "$home/$toplevel";
  311.     (!-d $dir) && mkdir($dir, 0700);
  312.     $dir .= "/$organization";
  313.     (!-d $dir) && mkdir($dir, 0700);
  314.  
  315.     &deposit("$dir/$from");
  316. }
  317.  
  318.  
  319. # =====
  320. # Subroutine openpipe
  321. #    Open a pipe to a command and write the mail message to it.
  322. #
  323. sub openpipe{
  324.     local($command) = @_;
  325.  
  326.     open(CMD, "| $command") || die;
  327.     print CMD "$header\n";
  328.     print CMD "$body\n\n" if defined($body);
  329. }
  330.  
  331. 1;
  332.